home *** CD-ROM | disk | FTP | other *** search
/ Aminet 38 / Aminet 38 (2000)(Schatztruhe)[!][Aug 2000].iso / Aminet / dev / basic / ImageDTInfo.lha / ImageDTInfo / ImageDTInfo.bas < prev    next >
Encoding:
BASIC Source File  |  2000-05-26  |  4.6 KB  |  151 lines
  1. ' ===========================================================================
  2. '  ImageDTInfo by © 1999-2000 Dámaso D. Estévez
  3. '     Fido : 2:348/613.44
  4. '     Inet : amidde@arrakis.es
  5. '      WWW : http://www.arrakis.es/~amidde/
  6. '
  7. ' ImageDTInfo.bas (main code/código principal)
  8. '
  9. '   For to compile this, use the compiler prefs file "HBCImageDTInfo.opts"
  10. '           (the `Tokens.t' file IS NEEDED for to compile this code...
  11. '      except if you include the `Tokens.bas' code in this code at start).
  12. '                                 -----------
  13. '         Para compilar este programa utilice el fichero de prefencias
  14. '         del compilador "HBCImageDTInfo.opts" (el fichero `Tokens.t'
  15. '                ES NECESARIO para poder compilar el programa...
  16. '   salvo si incluye el código de `Tokens.bas' al inicio de este código :D).
  17. ' ===========================================================================
  18. '      Created for use with FWCalendar Arexx script written by Ron Goertz
  19. '         and as a little coding exercise with (Hisoft|Maxon) Basic 2.
  20. '             You can re-use freely this code in your own works.
  21. '                                ------------
  22. '        Creado para usar con el guión ARexx FWCalendar de Ron Goertz
  23. '   y como un pequeño ejercicio de programación con (Hisoft|Maxon) Basic 2.
  24. '        Puede reutilizar libremente este código en sus producciones.
  25. ' ===========================================================================
  26.  
  27. ' -- Locale support --
  28. ' -- Soporte local ---
  29. ' --------------------
  30. REM $include BH:BLib/GetCString.bas
  31. REM $include Locale/ImageDTInfo_Locale.bc
  32. REM $include Locale/ImageDTInfo_Locale.bas
  33.  
  34. DIM SHARED localeInfo&(2)
  35.  
  36. FUNCTION CadLc$(BYVAL id&)
  37.     CadLc$ = PEEK$(GetCString&(VARPTR(localeInfo&(0)),id&))
  38. END FUNCTION
  39.  
  40. ' - Loading my modules with functions/subroutines -
  41. ' - Cargando mis módulos con funciones/subrutinas -
  42. ' -------------------------------------------------
  43. REM $include AuxRoutines/GetArg.bas
  44. REM $include AuxRoutines/InfoImgFile.bas
  45.  
  46. '   =====================================================================
  47. '                          Main code / Código principal
  48. '   =====================================================================
  49.  
  50. ' ---- Opening libraries ----
  51. ' - Apertura de bibliotecas -
  52. ' ---------------------------
  53.  
  54. ' OpenCatalogA(), CloseCatalog()
  55. LIBRARY OPEN "locale.library",39
  56.  
  57. ' --------- Shared vars for error handling --------
  58. ' -- Variables compartidas de gestión de errores --
  59. ' -------------------------------------------------
  60. en& = 0&
  61. em$ = ""
  62.  
  63. ' ----------- Opening locale library ---------
  64. ' - Apertura biblioteca de prestación local --
  65. ' --------------------------------------------
  66. localeInfo&(0) = LIBRARY("locale.library")
  67. IF localeInfo&(0) <> NULL& THEN
  68.     localeInfo&(1) = OpenCatalogA&(NULL&, SADD("ImageDTInfo.catalog" + CHR$(0)), NULL&)
  69. END IF
  70.  
  71. ' ---- Calling the main routine ----
  72. ' - Llamando a la rutina principal -
  73. ' ----------------------------------
  74. CALL main(COMMAND$)
  75.  
  76. IF LIBRARY("locale.library") <> NULL& THEN
  77.         CloseCatalog localeInfo&(1)
  78. END IF
  79.  
  80. END
  81.  
  82. '   =====================================================================
  83. '                    "Main"subroutine / Sub-rutina "Main"
  84. '   =====================================================================
  85.  
  86. SUB main(cad$) SHARED en&,em$
  87. LOCAL tmp$,version$
  88.  
  89.     ' -- Variables initialization ---
  90.     ' - Inicialización de variables -
  91.     '--------------------------------
  92.  
  93.     ' Copyright string / Cadena de autoría
  94.     version$ ="$VER: ImageDTInfo 1.5 (26.5.00) by © Dámaso D. Estévez <amidde@arrakis.es>"
  95.  
  96.     ' ---- Asking the first argument ----
  97.     ' - Solicitando el primer argumento -
  98.     ' -----------------------------------
  99.     cad$=getarg$(cad$,1)
  100.  
  101.     ' - There is the argument? -
  102.     ' ---- ¿Hay argumento? -----
  103.     ' --------------------------
  104.     IF cad$<>"" THEN
  105.  
  106.         tmp$=InfoImgFile$(cad$)
  107.  
  108.         IF tmp$<>"" AND en&=0 AND em$="" THEN
  109.  
  110.             PRINT tmp$
  111.  
  112.         ELSE
  113.  
  114.             ' --------- If there was some error, -----------
  115.             ' ------ prints the error code (& message) -----
  116.  
  117.             ' - Si se ha producido algún error, se imprime -
  118.             ' ------ el código (y el mensaje de error) -----
  119.             ' ----------------------------------------------
  120.  
  121.             PRINT CadLc$(ERROR_TITLE&);
  122.             IF en&<>0 THEN
  123.                 PRINT " - ";CadLc$(ERROR_CODE_INFO&);": ";en&
  124.             ELSE
  125.                 PRINT
  126.             END IF
  127.  
  128.             PRINT CadLc$(ERROR_ARG_INFO&)": `";cad$;"'"
  129.  
  130.             IF em$<>"" THEN
  131.                 PRINT em$
  132.             END IF
  133.  
  134.         END IF
  135.  
  136.     ELSE
  137.  
  138.         ' -------- The user didn't include a filename as argument ----------
  139.         ' - El usuario no ha incluído un nombre de fichero como argumento --
  140.         ' ------------------------------------------------------------------
  141.         PRINT
  142.  
  143.         PRINT RIGHT$(version$,LEN(version$)-6)
  144.         PRINT
  145.         PRINT CadLc$(ERROR_ONLY_ONE_ARG&)
  146.         PRINT
  147.  
  148.     END IF
  149.  
  150. END SUB
  151.